home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch12 / 2dSquare.cls < prev    next >
Text File  |  1999-06-17  |  4KB  |  137 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "TwoDSquare"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15. ' Two-dimensional square object.
  16.  
  17. Implements TwoDObject
  18.  
  19. ' Coordinates of the center.
  20. Public X As Single
  21. Public Y As Single
  22.  
  23. ' Width = height.
  24. Public Width As Single
  25.  
  26. ' Drawing properties.
  27. Private m_DrawWidth As Integer
  28. Private m_DrawStyle As DrawStyleConstants
  29. Private m_ForeColor As OLE_COLOR
  30. Private m_FillColor As OLE_COLOR
  31. Private m_FillStyle As FillStyleConstants
  32.  
  33. Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  34. ' Draw the object in a metafile.
  35. Private Sub TwoDObject_DrawInMetafile(ByVal mf_dc As Long)
  36.     SetMetafileDrawingParameters Me, mf_dc
  37.  
  38.     Rectangle mf_dc, X - Width / 2, Y - Width / 2, X + Width / 2, Y + Width / 2
  39.  
  40.     RestoreMetafileDrawingParameters mf_dc
  41. End Sub
  42. ' Return the object's DrawWidth.
  43. Public Property Get TwoDObject_DrawWidth() As Integer
  44.     TwoDObject_DrawWidth = m_DrawWidth
  45. End Property
  46. ' Set the object's DrawWidth.
  47. Public Property Let TwoDObject_DrawWidth(ByVal new_value As Integer)
  48.     m_DrawWidth = new_value
  49. End Property
  50.  
  51. ' Return the object's DrawStyle.
  52. Public Property Get TwoDObject_DrawStyle() As DrawStyleConstants
  53.     TwoDObject_DrawStyle = m_DrawStyle
  54. End Property
  55. ' Set the object's DrawStyle.
  56. Public Property Let TwoDObject_DrawStyle(ByVal new_value As DrawStyleConstants)
  57.     m_DrawStyle = new_value
  58. End Property
  59.  
  60. ' Return the object's ForeColor.
  61. Public Property Get TwoDObject_ForeColor() As OLE_COLOR
  62.     TwoDObject_ForeColor = m_ForeColor
  63. End Property
  64. ' Set the object's ForeColor.
  65. Public Property Let TwoDObject_ForeColor(ByVal new_value As OLE_COLOR)
  66.     m_ForeColor = new_value
  67. End Property
  68.  
  69. ' Return the object's FillColor.
  70. Public Property Get TwoDObject_FillColor() As OLE_COLOR
  71.     TwoDObject_FillColor = m_FillColor
  72. End Property
  73. ' Set the object's FillColor.
  74. Public Property Let TwoDObject_FillColor(ByVal new_value As OLE_COLOR)
  75.     m_FillColor = new_value
  76. End Property
  77.  
  78. ' Return the object's FillStyle.
  79. Public Property Get TwoDObject_FillStyle() As FillStyleConstants
  80.     TwoDObject_FillStyle = m_FillStyle
  81. End Property
  82. ' Set the object's FillStyle.
  83. Public Property Let TwoDObject_FillStyle(ByVal new_value As FillStyleConstants)
  84.     m_FillStyle = new_value
  85. End Property
  86.  
  87. ' Return this object's bounds.
  88. Public Sub TwoDObject_Bound(ByRef xmin As Single, ByRef xmax As Single, ByRef ymin As Single, ByRef ymax As Single)
  89.     xmin = X - Width / 2
  90.     xmax = X + Width / 2
  91.     ymin = Y - Width / 2
  92.     ymax = Y + Width / 2
  93. End Sub
  94. ' Draw the object on the canvas.
  95. Public Sub TwoDObject_Draw(ByVal canvas As Object)
  96.     SetCanvasDrawingParameters Me, canvas
  97.     canvas.Line (X - Width / 2, Y - Width / 2)-Step(Width, Width), , B
  98. End Sub
  99. ' Initialize the object using a serialization string.
  100. ' The serialization does not include the
  101. ' ObjectType(...) part.
  102. Private Property Let TwoDObject_Serialization(ByVal RHS As String)
  103. Dim token_name As String
  104. Dim token_value As String
  105.  
  106.     InitializeDrawingProperties Me
  107.  
  108.     ' Read tokens until there are no more.
  109.     Do While Len(RHS) > 0
  110.         ' Read a token.
  111.         GetNamedToken RHS, token_name, token_value
  112.         Select Case token_name
  113.             Case "X"
  114.                 X = CSng(token_value)
  115.             Case "Y"
  116.                 Y = CSng(token_value)
  117.             Case "Width"
  118.                 Width = CSng(token_value)
  119.             Case Else
  120.                 ReadDrawingPropertySerialization Me, token_name, token_value
  121.         End Select
  122.     Loop
  123. End Property
  124.  
  125. ' Return a serialization string for the object.
  126. Public Property Get TwoDObject_Serialization() As String
  127. Dim txt As String
  128.  
  129.     txt = DrawingPropertySerialization(Me)
  130.     txt = txt & " X(" & Format$(X) & ")"
  131.     txt = txt & " Y(" & Format$(Y) & ")"
  132.     txt = txt & " Width(" & Format$(Width) & ")"
  133.     TwoDObject_Serialization = "TwoDSquare(" & txt & ")"
  134. End Property
  135.  
  136.  
  137.